(DEFPROP CREFL 
 (NIL CREFL
      CREF
      CREF0
      CREF1
      ALPHA
      ALPHA1
      ALPHA2
      ALPHA3
      FTCON
      FTCON1
      FTCON2
      JOIN
      REF
      DELETE
      SETDIFF
      TRPEND
      SPACES2
      POS
      LPRINT
      XFF
      XBLNK
      INIT) 
VALUE)

(DEFPROP CREF 
 (LAMBDA(U)
  (PROG (V W X)
	(SETQ W (CAR U))
	(COND
	 ((NOT (EQ W (QUOTE TTY:)))
	  (OUTC (EVAL (LIST (QUOTE OUTPUT) W (QUOTE FOO))) T)))
	(SETQ U (CDR U))
   A    (COND ((NULL U) (GO END))
	      ((EQUAL (LAST (EXPLODE (CAR U))) (QUOTE (:)))
	       (GO DEV))
	      ((NULL V) (GO ERR)))
	(INC (EVAL (CONS (QUOTE INPUT) (LIST V (CAR U)))))
   A1   (COND
	 ((EQ (SETQ X (ERRSET (READ) T)) (QUOTE $EOF$)) (GO D))
	 ((MEMBER (SETQ X (CAR X)) (QUOTE (DEFINE MACRO)))
	  (MAPCAR (FUNCTION REF) (CAR (READ)))))
	(GO A1)
   D    (INC NIL)
   D1   (SETQ U (CDR U))
	(GO A)
   DEV  (SETQ V (CAR U))
	(SETQ U (CDR U))
	(GO A)
   END  (INC NIL)
	(PRINC XFF)
	(CREF0)
	(OUTC NIL T)
	(RETURN (QUOTE ***))
   ERR  (OUTC NIL T)
	(PRINC (QUOTE ILLEGAL/ DEVICE))
	(TERPRI)
	(GO D1))) 
FEXPR)

(DEFPROP CREF0 
 (LAMBDA NIL
  (PROG NIL
	(TERPRI)
	(SETQ ALIS NIL)
	(ALPHA1)
	(CREF1 ALIS))) 
EXPR)

(DEFPROP CREF1 
 (LAMBDA(A)
  (PROG (X)
   B    (COND ((NULL A) (RETURN NIL))
	      ((NULL (SETQ X (GET (CAR A) (QUOTE CNX)))) (GO C)))
	(TERPRI)
	(PRIN1 (CAR A))
	(SPACES2 15)
	(PRINC (QUOTE CALLED/ BY))
	(LPRINT (ALPHA X) 35)
	(GO D)
   C    (COND ((NULL (GET (CAR A) (QUOTE CALLS))) (GO D)))
	(TERPRI)
	(PRIN1 (CAR A))
	(SPACES2 20)
	(PRINC (QUOTE *****/ NOT/ CALLED/ *****))
	(TERPRI)
   D    (SETQ A (CDR A))
	(GO B))) 
EXPR)

(DEFPROP ALPHA 
 (LAMBDA(U)
  (PROG NIL
	(SETQ ALIS NIL)
	(MAPCAR (FUNCTION ALPHA2) U)
	(RETURN (MAPLIST (FUNCTION CAAR) ALIS)))) 
EXPR)

(DEFPROP ALPHA1 
 (LAMBDA NIL
  (PROG2 (MAP (FUNCTION
	       (LAMBDA (J) (MAPCAR (FUNCTION ALPHA3) (CAR J))))
 	      OBLIST)
	 (SETQ ALIS  
	        (MAPLIST (FUNCTION CAAR) ALIS)))) 
EXPR)

(DEFPROP ALPHA2 
 (LAMBDA(U)
  (PROG (V W)
	(SETQ W
	      (EXAMINE
	       (MAKNUM (CAR (GET U (QUOTE PNAME))) (QUOTE FIXNUM))))
	(COND ((NULL (SETQ V ALIS)) (RETURN (SETQ ALIS (LIST (CONS U W))))))
   A    (COND
	 ((LESSP W (CDAR V))
	  (RETURN
	   (RPLACA (RPLACD V (CONS (CAR V) (CDR V))) (CONS U W))))
	 ((NULL (CDR V)) (RETURN (NCONC V (LIST (CONS U W))))))
	(SETQ V (CDR V))
	(GO A))) 
EXPR)

(DEFPROP ALPHA3 
 (LAMBDA (U) (AND (OR (GET U (QUOTE CALLS)) (GET U (QUOTE CNX))) (ALPHA2 U))) 
EXPR)

(DEFPROP FTCON 
 (LAMBDA(U)
  (PROG2 (SETQ LVAR (CADR U)) (FTCON2 (FTCON1 (CDDR U))))) 
EXPR)

(DEFPROP FTCON1 
 (LAMBDA(U)
  (PROG (V)
   A    (COND ((NULL U) (RETURN V))
	      ((ATOM (CAR U))
	       (COND
		((MEMBER (CAR U) (QUOTE (PROG LAMBDA)))
		 (PROG2 (SETQ LVAR (JOIN (CADR U) LVAR))
			(SETQ U (CDR U))))
		((EQ (CAR U) (QUOTE GO))
		 (PROG2 (SETQ LVAR (JOIN (CDR U) LVAR)) (RETURN V)))
		((NUMBERP (CAR U)) NIL)
		((AND (EQ (CAR U) (QUOTE SETQ))
		      (MEMBER (CADR U) LVAR))
		 (SETQ U (CDR U)))
		((EQ (CAR U) (QUOTE QUOTE)) (RETURN V))
		(T (SETQ V (CONS (CAR U) V)))))
	      (T (SETQ V (JOIN (FTCON1 (CAR U)) V))))
	(SETQ U (CDR U))
	(GO A))) 
EXPR)

(DEFPROP FTCON2 
 (LAMBDA(V)
  (PROG (X Y)
	(SETQ Y (JOIN (QUOTE (T NIL)) LVAR))
   A    (COND ((NULL V) (RETURN X))
	      ((OR (MEMBER (CAR V) Y) (GET (CAR V) (QUOTE NOLIST)))
	       NIL)
	      (T (SETQ X (CONS (CAR V) X))))
	(SETQ V (CDR V))
	(GO A))) 
EXPR)

(DEFPROP JOIN 
 (LAMBDA (A B) (COND ((NULL A) B) ((NULL B) A) (T (TRPEND A B)))) 
EXPR)

(DEFPROP REF 
 (LAMBDA(UU)
  (PROG (PV1)
	(TERPRI)
	(COND ((GET (CAR UU) (QUOTE NOLIST)) (RETURN NIL)))
	(SETQ PV1 (SETDIFF (FTCON (CADR UU)) LVAR))
	(PUTPROP (CAR UU) T (QUOTE CALLS))
	(MAPLIST (FUNCTION
		  (LAMBDA(J)
		   (PUTPROP (CAR J)
			    (TRPEND (LIST (CAR UU))
				    (GET (CAR J) (QUOTE CNX)))
			    (QUOTE CNX))))
 		 PV1)
	(PRIN1 (CAR UU))
	(SPACES2 15)
	(PRIN1 (QUOTE CALLS))
	(COND ((NULL PV1)
	       (PROG2 (SPACES2 35)
		      (PRINC (QUOTE *****/ NO/ FUNCTION/ *****))
		      (TERPRI)))
	      (T (LPRINT (ALPHA PV1) 35))))) 
EXPR)

(DEFPROP DELETE 
 (LAMBDA(X Y)
  (COND ((NULL Y) NIL)
	((EQUAL X (CAR Y)) (CDR Y))
	(T (CONS (CAR Y) (DELETE X (CDR Y)))))) 
EXPR)

(DEFPROP SETDIFF 
 (LAMBDA(X Y)
  (COND ((NULL Y) X) (T (SETDIFF (DELETE (CAR Y) X) (CDR Y))))) 
EXPR)

(DEFPROP TRPEND 
 (LAMBDA(U V)
  (PROG NIL
   A    (COND ((NULL U) (RETURN V))
	      ((NOT (MEMBER (CAR U) V)) (SETQ V (CONS (CAR U) V))))
	(SETQ U (CDR U))
	(GO A))) 
EXPR)

(DEFPROP SPACES2 
 (LAMBDA(V)
  (PROG NIL
	(COND ((GREATERP (POS) V) (TERPRI)))
	(SETQ V (DIFFERENCE V (POS)))
   A    (COND ((EQ V 0) (RETURN NIL)))
	(PRINC XBLNK)
	(SETQ V (SUB1 V))
	(GO A))) 
EXPR)

(DEFPROP POS 
 (LAMBDA NIL (DIFFERENCE (LINELENGTH NIL) (CHRCT))) 
EXPR)

(DEFPROP LPRINT 
 (LAMBDA(U N)
  (PROG NIL
   A    (SPACES2 N)
   B    (COND ((NULL U) (RETURN (TERPRI)))
	      ((GREATERP (FLATSIZE (CAR U)) (SUB1 (CHRCT))) (GO C)))
	(PRIN1 (CAR U))
	(PRINC XBLNK)
	(SETQ U (CDR U))
	(GO B)
   C    (TERPRI)
	(GO A))) 
EXPR)

(DEFPROP XFF 
 (NIL . /) 
VALUE)

(DEFPROP XBLNK 
 (NIL . / ) 
VALUE)

(DEFPROP INIT 
 (LAMBDA NIL
  (MAP (FUNCTION
	(LAMBDA (J) (PUTPROP (CAR J) (CAR J) (QUOTE NOLIST))))
       (QUOTE
	(AND ATOM
 	     CAR
 	     CDR
 	     CAAR
 	     CADR
 	     CDAR
 	     CDDR
 	     CAAAR
 	     CAADR
 	     CADAR
 	     CADDR
 	     CDAAR
 	     CDADR
 	     CDDAR
 	     CDDDR
 	     CAAAAR
 	     CAAADR
 	     CAADAR
 	     CAADDR
 	     CADAAR
 	     CADADR
 	     CADDAR
 	     CADDDR
 	     CDAAAR
 	     CDAADR
 	     CDADAR
 	     CDADDR
 	     CDDAAR
 	     CDDADR
 	     CDDDAR
 	     CDDDDR
 	     COND
 	     CONS
 	     EQ
 	     EQUAL
 	     GO
 	     LIST
 	     NOT
 	     NULL
 	     OR
 	     PROG
 	     PROG2
 	     QUOTE
 	     RETURN
 	     FUNCTION)))) 
EXPR)

(INIT)


(NOUUO NIL)